home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
001
/
pibt40s1.arc
/
ERRORHAN.MOD
< prev
next >
Wrap
Text File
|
1987-04-23
|
3KB
|
86 lines
(*----------------------------------------------------------------------*)
(* Error_Handler --- Handle program aborts by exiting gracefully *)
(*----------------------------------------------------------------------*)
PROCEDURE Error_Handler;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Error_Handler *)
(* *)
(* Purpose: Handle PibTerm program aborts by halting gracefully *)
(* *)
(* Calling Sequence: *)
(* *)
(* Error_Handler( ErrNo , ErrAddr : INTEGER ); *)
(* *)
(* ErrNo --- error number/type *)
(* ErrAddr --- address where error occurred *)
(* *)
(* Remarks: *)
(* *)
(* This routine needs to be cleaned up to handle file closing *)
(* better at some point. *)
(* *)
(*----------------------------------------------------------------------*)
VAR
I : INTEGER;
(* STRUCTURED *) Const
Sorry_Mess : STRING[60]
= 'Sorry, there has been a system error, please call back later';
Discon_Mess : STRING[17]
= 'Disconnecting....';
BEGIN (* Error_Handler *)
(* Make sure we're in text mode *)
TextMode( Text_Mode );
(* Send notice of fatal error (also to *)
(* caller in host mode) and quit. *)
IF ( ErrNo > 0 ) THEN
BEGIN
IF Host_Mode THEN
BEGIN
Async_Send_String(' ');
Async_Send_String(Sorry_Mess);
Async_Send_String(Discon_Mess);
WRITELN;
WRITELN(Sorry_Mess);
WRITELN(Discon_Mess);
END
ELSE
BEGIN
WRITELN;
WRITELN('Sorry, there has been a serious PibTerm error.');
END;
(* Report error number and type *)
I := LO( ErrNo );
WRITE('Error number: ', Dec_To_Hex( I ), ' = ' );
CASE HI( ErrNo ) OF
0: WRITE('User break');
1: WRITE('I/O error');
2: WRITE('Run time error');
ELSE
WRITE('Unknown Error');
END (* CASE *);
WRITELN(' at address ',Dec_To_Hex( ErrAddr ),' (hexadecimal)');
END;
(* Close down all program facilities *)
FiniTerm;
WRITELN('PibTerm execution stopped ... ');
DELAY ( Three_Second_Delay );
(* Quit *)
Turbo_Halt( 2 );
END (* Error_Handler *);